home *** CD-ROM | disk | FTP | other *** search
/ Total Network Tools 2002 / NextStepPublishing-TotalNetworkTools2002-Win95.iso / Archive / Misc Servers / RadioChat Chat-Server.exe / rc_373den.pkg / source.ext / sample.dpr < prev    next >
Encoding:
Text File  |  1998-12-23  |  4.2 KB  |  102 lines
  1. (*
  2.      RadioChat Example Extension-API Library
  3.      
  4.      Confidental property of Dirk Faust
  5.      Use this as a macro for scripting your own RC-API-Extensions
  6. *)
  7.  
  8. library sample;                                 // Will be compiled/linked to sample.dll
  9.  
  10. uses windows, sysutils;
  11.  
  12. {$R *.RES}
  13.  
  14. {$include RCinclude.pas}
  15.  
  16. Function DLL_Show_WhereAmI(ucb:TUCB; input:PChar):Boolean; cdecl far;
  17. // example for RCRoomInfo & RCSendUID
  18. var rcb:TRCB;
  19.     pc, pc2:PChar;
  20.     gast:String;
  21. begin
  22.   GetMem(pc, 200);                                    // Memory for output-string
  23.   GetMem(pc2, 200);                                   // Memory for UID-String
  24.   rcb:=RCRoomInfo(ucb.uraum);                        // Fill "rcb" with roominfo of caller (where he is)
  25.   if rcb.superuid=ucb.uid then begin                  // Is caller SuperUser of room?
  26.     gast:='<b>SuperUser</b>';                         // Yep, tell him
  27.   end else begin
  28.     gast:='Guest';                                     // No, say he is only a guest here
  29.   end;
  30.   strpcopy(pc, '<font size=2><i>You are as '+gast+' in room '+rcb.rname+'</i></font><BR>'#10);
  31.   strpcopy(pc2, ucb.uid);
  32.   RCWriteUID(pc2, pc);                               // Write row to UID (caller - this time)
  33.   FreeMem(pc2, 200);                                  // Free memory
  34.   FreeMem(pc, 200);
  35.   result:=TRUE;                                       // Tell the Server that we are all right.
  36. end;
  37.  
  38. Function DLL_Punch(ucb:TUCB; input:PChar):Boolean; cdecl far;
  39. // example for RCSendUID & RCUIDFromName; also an exmaple for the input-string
  40. var SourceRow, TargetRow, SourceUID, TargetUID:PChar;
  41.     s, target, say:String;
  42.     i, i2:Integer;
  43.     ch:Char;
  44. begin
  45.   GetMem(SourceRow, 500);                            // Memory for output to caller
  46.   GetMem(SourceUID, 500);                            // Memory for UID of caller
  47.   GetMem(TargetRow, 500);                            // Memory for output to destination
  48.   GetMem(TargetUID, 500);                            // Memory for destination UID
  49.  
  50.   s:=StrPas(input);                                  // Delphi works better with strings.. convert it
  51.   i:=1;
  52.   target:='';                                        // Process input.. input may be /schlage testy [Du Sack]
  53.   repeat                                             // Scan string for a space ' '
  54.     ch:=s[i];
  55.     if ch<>' ' then target:=target+ch;
  56.     inc(i);
  57.   until (i>length(s)) or (ch=' ');                   // ok, till here we got the target-name
  58.   if ch=' ' then inc(i);
  59.   say:='';
  60.   if i<=length(s) then begin                         // copy the rest as a sentence to send by the way
  61.     for i2:=i to length(s) do say:=say+s[i2];
  62.   end;
  63.   if say='' then say:='nothing' else say:='"'+say+'"';// no sentence? - doesn't matter ;}
  64.  
  65.   if target<>'' then begin                           // is the target-name empty?
  66.     strpcopy(SourceUID, ucb.uid);                    // no..
  67.     strpcopy(TargetRow, target);                     // get the UID of the target-chatter
  68.     RCUIDFromName(TargetRow, TargetUID);
  69.     if TargetUID<>nil then if StrPas(TargetUID)<>'' then begin // only if a target found...
  70.       strpcopy(SourceRow, '<font color="red"><i>You punch '+target+' and say '+say+'...</i></font><BR>'#10);
  71.       RCWriteUID(SourceUID, SourceRow);                       //
  72.       strpcopy(TargetRow, '<font color="red"><i>'+ucb.uname+' says '+say+' and punch you.</i></font><BR>'#10);
  73.       RCWriteUID(TargetUID, TargetRow);
  74.     end else begin
  75.     // No, no targetUID could be found - say it to him!
  76.       strpcopy(SourceRow, '<i>'+target+' is not here...</i><BR>'#10);
  77.       RCWriteUID(SourceUID, SourceRow);
  78.     end;
  79.   end;
  80.   FreeMem(TargetUID, 500);
  81.   FreeMem(TargetRow, 500);
  82.   FreeMem(SourceUID, 500);
  83.   FreeMem(SourceRow, 500);
  84.   result:=TRUE;
  85. end;
  86.  
  87. Function DLL_AdminMessage(ucb:TUCB; input:PChar):Boolean; cdecl far;
  88. var pc:PChar;
  89. begin
  90.   GetMem(pc, 200);
  91.   strpcopy(pc, '<B><FONT COLOR="#'+ucb.ucolor+'">'+ucb.uname+'</FONT> (as ChatAdmin) to all:</B><FONT SIZE=4> '+UpperCase(input)+'</FONT><BR>'#10);
  92.   RCWriteAll(pc);
  93.   FreeMem(pc, 200);
  94.   result:=TRUE;
  95. end;
  96.  
  97. exports RCExtStart, // This MUST exist in every RC-Ext.API!
  98.         DLL_AdminMessage, DLL_Punch, DLL_Show_WhereAmI;
  99.  
  100. begin
  101. end.
  102.